home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / addflo / data1.cab / Program_Executable_Files / AddFlow / Samples / Pins / Pins.frm (.txt) next >
Encoding:
Visual Basic Form  |  1997-05-06  |  6.5 KB  |  197 lines
  1. VERSION 4.00
  2. Begin VB.Form Pins 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "Pins sample"
  5.    ClientHeight    =   4785
  6.    ClientLeft      =   1245
  7.    ClientTop       =   1065
  8.    ClientWidth     =   7035
  9.    Height          =   5475
  10.    Left            =   1185
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   4785
  15.    ScaleWidth      =   7035
  16.    ShowInTaskbar   =   0   'False
  17.    Top             =   435
  18.    Width           =   7155
  19.    Begin VB.TextBox Text1 
  20.       Height          =   765
  21.       Left            =   90
  22.       Locked          =   -1  'True
  23.       MultiLine       =   -1  'True
  24.       TabIndex        =   1
  25.       Text            =   "PINS.frx":0000
  26.       Top             =   120
  27.       Width           =   5865
  28.    End
  29.    Begin VB.CommandButton Command1 
  30.       Caption         =   "&Delete"
  31.       Height          =   465
  32.       Left            =   6060
  33.       TabIndex        =   0
  34.       Top             =   120
  35.       Width           =   885
  36.    End
  37.    Begin AddFlowLib.AddFlow AddFlow1 
  38.       Height          =   3765
  39.       Left            =   120
  40.       TabIndex        =   2
  41.       Top             =   960
  42.       Width           =   6855
  43.       _Version        =   65536
  44.       _ExtentX        =   12091
  45.       _ExtentY        =   6641
  46.       _StockProps     =   101
  47.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  48.          name            =   "Arial"
  49.          charset         =   0
  50.          weight          =   400
  51.          size            =   8.25
  52.          underline       =   0   'False
  53.          italic          =   0   'False
  54.          strikethrough   =   0   'False
  55.       EndProperty
  56.       BorderStyle     =   1
  57.       ScrollBars      =   3
  58.       Shape           =   1
  59.       LinkStyle       =   0
  60.       Alignment       =   7
  61.       AutoSize        =   0
  62.       ArrowDst        =   1
  63.       ArrowOrg        =   1
  64.       DrawStyle       =   0
  65.       DrawWidth       =   1,4013e-45
  66.       ReadOnly        =   0   'False
  67.       MultiSel        =   -1  'True
  68.       CanDrawNode     =   -1  'True
  69.       CanDrawLink     =   -1  'True
  70.       CanMoveNode     =   -1  'True
  71.       CanSizeNode     =   -1  'True
  72.       CanStretchLink  =   -1  'True
  73.       CanMultiLink    =   -1  'True
  74.       Transparent     =   0   'False
  75.       ShowGrid        =   0   'False
  76.       Hidden          =   0   'False
  77.       Rigid           =   0   'False
  78.       DisplayHandles  =   -1  'True
  79.       AutoScroll      =   -1  'True
  80.       xGrid           =   7,00649e-45
  81.       yGrid           =   7,00649e-45
  82.       xZoom           =   100
  83.       yZoom           =   100
  84.       FillColor       =   12648384
  85.       DrawColor       =   0
  86.       ForeColor       =   0
  87.       BackPicture     =   "PINS.frx":00F4
  88.    End
  89.    Begin VB.Menu FileMenu 
  90.       Caption         =   "&File"
  91.       Begin VB.Menu ExitMenu 
  92.          Caption         =   "&Exit"
  93.       End
  94.    End
  95.    Begin VB.Menu HelpMenu 
  96.       Caption         =   "&?"
  97.       Begin VB.Menu AboutMenu 
  98.          Caption         =   "&About..."
  99.       End
  100.    End
  101. Attribute VB_Name = "Pins"
  102. Attribute VB_Creatable = False
  103. Attribute VB_Exposed = False
  104. Option Explicit
  105. Private Sub AboutMenu_Click()
  106.   MsgBox "AddFlow: sample that shows how to use Rigid property" + Chr(13) + "Copyright 
  107.  1997 Lassalle Technologies"
  108. End Sub
  109. Private Sub AddFlow1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  110.   Dim lnkx As afLink
  111.   Dim nodeorg As afNode, nodedst As afNode, Org As afNode, Dst As afNode
  112.   Dim Xorg As Single, Yorg As Single, Xdst As Single, Ydst As Single
  113.   If AddFlow1.LastUserAction() = 2 Then  ' Link creation
  114.     Set lnkx = AddFlow1.SelectedLink
  115.     If Not (lnkx Is Nothing) Then
  116.       ' Get first and last point of the link
  117.       Xorg = lnkx.PointOrg.X
  118.       Yorg = lnkx.PointOrg.Y
  119.       Xdst = lnkx.PointDst.X
  120.       Ydst = lnkx.PointDst.Y
  121.       ' Get origin and destination nodes of our just created link
  122.       Set Dst = lnkx.Dst
  123.       Set Org = lnkx.Org
  124.       ' Now destroy the link ...
  125.       Org.OutLinks.Remove lnkx
  126.       ' Create 2 little hidden pins:
  127.       ' - the first is owned by the origin node
  128.       ' - the second is owned by the destination node
  129.       Set nodeorg = AddFlow1.Nodes.Add(Xorg - 15, Yorg - 15, 30, 30)
  130.       
  131.       ' Create a rigid link from Org to nodeorg
  132.       Set lnkx = Org.OutLinks.Add(nodeorg)
  133.       lnkx.Rigid = True
  134.       lnkx.Hidden = True
  135.       lnkx.Selectable = False
  136.       Set nodedst = AddFlow1.Nodes.Add(Xdst - 15, Ydst - 15, 30, 30)
  137.         
  138.       ' Create a rigid link from Dst to nodedst
  139.       Set lnkx = Dst.OutLinks.Add(nodedst)
  140.       lnkx.Rigid = True
  141.       lnkx.Hidden = True
  142.       lnkx.Selectable = False
  143.         
  144.       ' ... and recreate a new one with the two pins
  145.       ' as origin and destination.
  146.       Set lnkx = nodeorg.OutLinks.Add(nodedst)
  147.       
  148.       ' Make the two little black node unselectable and hidden
  149.       nodeorg.Hidden = True
  150.       nodeorg.Selectable = False
  151.       nodedst.Hidden = True
  152.       nodedst.Selectable = False
  153.     End If
  154.   End If
  155. End Sub
  156. Private Sub Command1_Click()
  157.   Dim lnkx As afLink, lnkx2 As afLink
  158.   ' Instead of removing each item with Remove method of collection, we
  159.   ' mark them and use at the ned the DeleteMarked method that deletes
  160.   ' all marked items.
  161.   With AddFlow1
  162.     If .SelectedNode Is Nothing And .SelectedLink Is Nothing Then
  163.       ' Do nothing
  164.     ElseIf .SelectedNode Is Nothing Then
  165.       ' If current item is a link, delete its origin and destination nodes.
  166.       .SelectedLink.Org.Marked = True
  167.       .SelectedLink.Dst.Marked = True
  168.     Else
  169.       ' If current item is a node, delete all its pins (= nodes
  170.       ' rigidly linked). We have also to destroy the other pin at the
  171.       ' other end of the link.
  172.       For Each lnkx In .SelectedNode.OutLinks
  173.         If lnkx.Rigid = True Then
  174.           ' Mark the pin owned by SelectedNode
  175.           lnkx.Dst.Marked = True
  176.           ' Mark all linked nodes for deletion.
  177.           ' Note: this will remove SelectedNode
  178.           For Each lnkx2 In lnkx.Dst.OutLinks
  179.             lnkx2.Dst.Marked = True
  180.           Next
  181.           For Each lnkx2 In lnkx.Dst.InLinks
  182.             lnkx2.Org.Marked = True
  183.           Next
  184.         End If
  185.       Next
  186.       .SelectedNode.Marked = True
  187.     End If
  188.     .DeleteMarked
  189.   End With
  190. End Sub
  191. Private Sub ExitMenu_Click()
  192.   End
  193. End Sub
  194. Private Sub Form_Load()
  195.   AddFlow1.Shape = afRectangle
  196. End Sub
  197.